www.gusucode.com > 星梦奇缘交友网 1 > 星梦奇缘交友网 1.0源码程序/love/url.asp

    <!--#include file=conn.asp-->
<!--#include file=config.asp-->
<%
dim geturl,les,Urlgo,furl
dim User,at,sql,rs,sqlc
	if left(WebUrl,1)="@" then
		geturl=trim(request.querystring("user"))
		if geturl<>""then
				geturl=replace(geturl,"http://","")
				at=instr(geturl,"@") 
			else
				response.write "系统出错，请稍后访问!"
		end if
		if at >0 then
			geturl=left(geturl,at-1)
		else
		response.redirect "index.asp"
		end if
	elseif left(WebUrl,1)="." then
	geturl=LCase(Request.ServerVariables("host"))
	if geturl<>""then
				geturl=replace(geturl,"http://","")
				at=split(geturl,".") 
			else
				response.write "系统出错，请稍后访问!"
		end if
		if at(0)<>"" and at(0)<>"www" then
			geturl=at(0)
		else
		response.redirect "index.asp"
		end if
	end if
	
	if geturl<>"" then''读写数据库
	call ilink(geturl)
	end if

Sub showRemoteFile(showurl) 
response.redirect showurl
End Sub

sub ilink(geturl)
dim Urlms,Urlgoto
set rs=server.createobject("adodb.recordset")
sql="select * from Ms_host where Urlname='"&geturl&"'"
rs.open sql,conn,1,3
if not (rs.eof and rs.bof) then
rs("click")=rs("click")+1
if day(rs("Lasttime"))=day(now()) then
rs("Dayclick")=rs("Dayclick")+1
else
rs("Dayclick")=1
end if
rs("Lasttime")=now()
rs.update
end if
rs.close
set rs=nothing
sql="select Urlms,Urlgoto from Ms_host where Urlname='"&geturl&"'"
set rs=conn.execute(sql)
if not (rs.eof and rs.bof) then
Urlms=rs(0)
Urlgoto=rs(1)
else
Urlms=0
Urlgoto="index.asp"
end if
rs.close

	if Urlms=0 then''简单跳转
		response.redirect Urlgoto
	else
		call showRemoteFile(Urlgoto)
	end if
end sub
set conn=nothing
%>